STAT3 : RELATION ENTRE DEUX VARIABLES QUANTITATIVES

Exo1 : Corrélation et régression

Auteur·rice

Jean-Paul N’GBESSO & Claude GRASLAND

Date de publication

2025-05-27

Le but de ce TD est de mettre en oeuvre les deux cours sur la corrélation et régression en fournissant un programme type d’analyse de la relation entre deux variables X et Y à l’aide de R. Ce programme pourra ensuite être facilement adapaté à d’autres jeux de données.

Télécharger l’exercice

1. PREPARATION DES DONNEES

1.1. Chargement du tableau principal

On charge le fichier des pays d’Afrique en 2018

don <- read.table(file = "data/africa_pays_2018/data/africa_pays_2018.csv", # nom du fichier et chemin d'accès
                  sep = ";",                     # séparateur (ici, des points-virgule)
                  dec=",",                       # Type de décimale
                  header = TRUE,                 # ligne d'en-tête avec le nom des variables
                  encoding="UTF-8")              # encodage adapté au français

1.2 Choix des deux variables à analyser

On sélectionne dans le tableau les variables qui serviront de code et de nom ainsi que les deux variable quantitatives X et Y que l’on veut mettre en relation. On change leur nom afin de pouvoir préparer un programme type.

sel<-don[,c("iso3","nom","URBANI","INTERN")]
colnames(sel)<-c("CODE","NOM","X","Y")
head(sel)
  CODE                  NOM    X    Y
1  AGO               Angola 65.9 14.3
2  BDI              Burundi 13.2  2.7
3  BEN                Bénin 47.6 20.0
4  BFA         Burkina Faso 29.7 16.0
5  BWA             Botswana 69.8 47.0
6  CAF Rep. Centrafricaine  41.6  4.3

1.3 Elimination des valeurs manquantes

On ne garde que les lignes du tableau qui sont complètes car autrement il risque d’y avoir des problèmes dans les analyses.

tab <-sel[complete.cases(sel), ]

1.4 On est malin …

On stocke des chaînes de caractères qu’on pourra utiliser dans les graphiques pour donner le titre général, le nom des axes et la source

# Pour la version française
titre <- "Les pays d'Afrique en 2018"
nomX <- "Taux d'urbanisation (%)"
nomY <- "Taux d'accès à internet (%)"
source <- "Ecole d'été AfromapR, Bouaké 2025"

2. ANALYSE DES VARIABLES X et Y

2.1 La distribution de X

Paramètres principaux

summary(tab$X)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   13.2    32.2    43.6    45.4    56.7    89.6 

Histogramme rapide

hist(tab$X)

Histogamme amélioré

hist(tab$X, 
     main=titre,
     sub = source,
     xlab = nomX,
     col="lightyellow",
     probability = TRUE
    )
lines(density(tab$X),
      col="red",
      lwd=2)
rug(tab$X,
    col="blue",
    lwd=2)

Boxplot rapide

boxplot(tab$X)

Boxplot améliorée

boxplot(tab$X,
        horizontal=T,
        col="lightyellow",
        main = titre,
        sub = source,
        xlab = nomX)

Tester la normalité

shapiro.test(tab$X)

    Shapiro-Wilk normality test

data:  tab$X
W = 0.97546, p-value = 0.3931

2.2 La distribution de Y

Paramètres principaux

summary(tab$Y)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   1.30    9.80   20.00   25.38   42.00   64.80 

Le taux d’accès à internet varie entre 1.3% et 64.8% avec une moyenne de 20% et une médiane de 25%. La moitié des pays ont un taux comprois entre 9.8% (Q1) et 42% (Q3).

Histogramme rapide

hist(tab$Y)

Histogamme amélioré

hist(tab$Y, 
     main=titre,
     sub = source,
     xlab = nomY,
     col="lightyellow",
     probability = TRUE
    )
lines(density(tab$Y),
      col="red",
      lwd=2)
rug(tab$Y,
    col="blue",
    lwd=2)

Boxplot rapide

boxplot(tab$Y)

Boxplot améliorée

boxplot(tab$Y,
        horizontal=T,
        col="lightyellow",
        main = titre,
        sub = source,
        xlab = nomY)

Tester la normalité

shapiro.test(tab$X)

    Shapiro-Wilk normality test

data:  tab$X
W = 0.97546, p-value = 0.3931

3. CORRELATION

3.1 Visualiser la relation entre X et Y

Graphique rapide

plot(tab$X,tab$Y)

Graphique amélioré

plot(tab$X,tab$Y,
     cex = 0.6,
     pch = 19,
     col = "red",
     main = titre,
     sub = source,
     xlab = nomX,
     ylab = nomY)
text(tab$X, tab$Y, tab$CODE,
     cex = 0.4,
     col = "blue",
     pos = 3)

3.2 Mesurer la corrélation entre X et Y

Coefficient de corrélation linéaire de Pearson (r)

pears <- cor(tab$X,tab$Y)
pears
[1] 0.530947

Coefficient de corrélation de rang de Spearman (rho)

spear <-cor(tab$X,tab$Y, method = "spearman")
spear
[1] 0.4656206

Coefficient de détermination (r2)

pears <- cor(tab$X,tab$Y)
100*pears**2
[1] 28.19048

Test de significativité (p-value)

cor.test(tab$X,tab$Y)

    Pearson's product-moment correlation

data:  tab$X and tab$Y
t = 4.2955, df = 47, p-value = 8.68e-05
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.2935825 0.7066417
sample estimates:
     cor 
0.530947 

4. REGRESSION LINEAIRE

4.1 Calculer l’équation de la droite Y = aX+B

monmodel <- lm(tab$Y~tab$X)

summary(monmodel)

Call:
lm(formula = tab$Y ~ tab$X)

Residuals:
    Min      1Q  Median      3Q     Max 
-28.337 -11.417  -2.522  12.700  33.105 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   1.1223     6.1037   0.184    0.855    
tab$X         0.5344     0.1244   4.295 8.68e-05 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 16.2 on 47 degrees of freedom
Multiple R-squared:  0.2819,    Adjusted R-squared:  0.2666 
F-statistic: 18.45 on 1 and 47 DF,  p-value: 8.68e-05

4.2 Visualiser la droite

plot(tab$X,tab$Y,
     cex = 0.6,
     pch = 19,
     col = "red",
     main = titre,
     sub = source,
     xlab = nomX,
     ylab = nomY)
text(tab$X, tab$Y, tab$CODE,
     cex = 0.4,
     col = "blue",
     pos = 3)
abline(monmodel, col ="black", lwd =2)

4.3 Calculer les valeurs estimées et les résidus

tab$Yest <- monmodel$fitted.values
tab$Yres <- monmodel$residuals

4.4 Afficher les résidus les plus négatifs

tri <- tab[order(tab$Yres),]
head(tri)
   CODE      NOM    X    Y     Yest      Yres
10  COG    Congo 67.2  8.7 37.03663 -28.33663
40  SOM  Somalie 45.3  2.0 25.33241 -23.33241
24  LBY    Libye 80.3 21.8 44.03778 -22.23778
1   AGO   Angola 65.9 14.3 36.34186 -22.04186
14  ERI Erythrée 40.4  1.3 22.71366 -21.41366
23  LBR  Libéria 51.4  8.0 28.59249 -20.59249

4.5 Afficher les résidus les plus positifs

tri <- tab[order(-tab$Yres),]
head(tri)
   CODE       NOM    X    Y     Yest     Yres
41  SWZ Swaziland 23.9 47.0 13.89542 33.10458
26  MAR     Maroc 62.8 64.8 34.68509 30.11491
44  TUN   Tunisie 69.1 64.2 38.05206 26.14794
13  EGY    Egypte 42.7 46.9 23.94287 22.95713
32  NAM   Namibie 50.5 51.0 28.11149 22.88851
12  DZA   Algérie 72.9 59.6 40.08293 19.51707

4.4 Exporter le tableau de résultats

write.table(tab, 
            file ="resultats_regression.csv",
            sep = ";",
            dec = ".",
            fileEncoding = "UTF-8")